Cream of the Crop 3/Cream of the Crop 3.iso/comm/odys200a.zip/ODY200SH.LZH/ODYHOST.HSC

Text File | 1993-04-26 | 12KB | 452 lines

SCRIPT OdyHost;

(************************************************************************)
(*                                                                      *)
(*                     Odyssey Host Mode Script                         *)
(*                Copyright (c) Don Milne, July 1990                    *)
(*                                                                      *)
(************************************************************************)

VAR DefaultBaudRate:Number;
    GotLeaveCmd,PrivUser,LostCarrier:Flag;
    CurrDir,OrigDir:String;
    FileOK,GotChar,Carrier,AlreadyConnected,Busy:Flag;
    OldCrMode:Number;

(* Host mode info, configured in Odyssey by user *)
VAR NormPass,PrivPass,Welcome,HostDir:String;
    MNPwanted:Flag;

(*.........................................*)

FUNC CarrierLost():Flag;

VAR tempcarrier:Flag;

BEGIN
     IF LostCarrier THEN RETURN(TRUE) END;
     tempcarrier := OnLine();
     IF (Carrier<>tempcarrier) AND (NOT tempcarrier) THEN
         Delay(1);
         IF NOT OnLine() THEN
             LostCarrier:=TRUE;
             Carrier := FALSE;
             AlreadyConnected := FALSE;
             RETURN TRUE
         END;
     END;
     RETURN FALSE;
END;

(*.........................................*)

PROC SendString(s:String);
BEGIN
     Write(s); Transmit(s);
END;

(*.........................................*)

FUNC GetString(VAR s:String; Timout:Number):Flag;
BEGIN
     IF Receive(s,Timout) THEN
         Write(s+"|");
         RETURN TRUE;
     END;
     RETURN FALSE;
END;

(*.........................................*)

FUNC LeaveHostMode():Flag;
BEGIN
     IF NOT GotLeaveCmd THEN
         WHILE KeyPressed() DO (* leave host mode? *)
             IF RdKey()=27 THEN
                 GotLeaveCmd := TRUE;
             END;
         END;
     END;
     RETURN GotLeaveCmd;
END;

(*.........................................*)

FUNC GetPassWord():Flag;

VAR Attempts:Number;
    GotPassword,Failure:Flag;
    Password:String[20];

BEGIN
     PrivUser := FALSE;
     GotPassword := FALSE;
     Failure := FALSE;
     Attempts := 0;
     REPEAT
           SendString("|Enter Password: ");
           Receive(Password,10,NoEcho);
           IF Password = PrivPass THEN
               PrivUser := TRUE;
               GotPassword := TRUE
             ELSIF Password = NormPass THEN
               GotPassword := TRUE
             ELSE
               SendString("Incorrect ("+Password+")"); INC(Attempts);
               Failure := (Attempts>=3);
               IF Failure THEN
                   SendString("||Wrong too often.. Byeee|");
                   HangUp();
               END;
           END
     UNTIL GotPassword OR Failure;
     RETURN GotPassword;
END;

(*.........................................*)

PROC ChangeDirectory();

VAR Temp:String;

BEGIN
     SendString("|Directory? ");
     IF GetString(Temp,30) THEN
         IF Temp="" THEN RETURN END;
         IF ChDir(Temp) THEN
             CurrDir := Temp
           ELSE
             SendString("No such directory");
             ChDir(CurrDir);
         END;
     END;
END;

(*.........................................*)

PROC DirectoryListing();

VAR Lines,Count,f_attr:Number;
    GotFile:Flag;
    Temp:String;
    Name:String[20];

BEGIN
     SendString("Dir Mask? ");
     IF NOT GetString(Temp,30) THEN RETURN END;
     SendString('|');
     IF Temp="" THEN Temp:="*.*" END;
     GotFile := FFirst(Temp,0,Name,f_attr);
     IF GotFile THEN
         Count:=0; Lines:=0;
         WHILE (GotFile) AND (NOT CarrierLost()) DO
             Temp := Name;
             Temp := SubStr(Temp+"              ",0,14);
             SendString(Temp);
             GotFile := FNext(Name,f_attr);
             INC(Count);
             IF Count % 5 = 0 THEN
                 INC(Lines); SendString('|');
                 IF Lines=20 THEN
                     SendString("||More...");
                     GetString(temp,30);
                     IF CarrierLost() THEN RETURN END;
                     SendString('||');
                 END;
             END;
         END;
       ELSE
         SendString("No matching files.|");
     END;
     SendString('||');
END;

(*................................................*)

FUNC GetFilename(VAR Filename:String; MustExist:Flag):Flag;
BEGIN
     SendString("|Filename? ");
     IF NOT GetString(Filename,30) THEN
         SendString('|');
       ELSE
         IF (Length(Filename)>12) OR (Pos(":",Filename)>=0) OR (Pos("\",Filename)>=0) THEN
             (* for security reasons, path and drive names are not allowed *)
             SendString("|Bad File name|");
             RETURN FALSE;
         END;
         IF IsFile(Filename) THEN
             IF MustExist THEN
                 RETURN TRUE
               ELSE
                 SendString("|Filename used already - pick another!|");
             END;
           ELSIF MustExist THEN
             SendString("|File not found.|");
           ELSE
             RETURN TRUE
         END;
     END;
     RETURN FALSE;
END;

(*................................................*)

FUNC GetFTMethod(AsciiOK:Flag):Number;

VAR c:String[2];
    x:Number;

BEGIN
     SendString("Choose method=>|");
     IF AsciiOK THEN SendString("A(scii|") END;
     SendString("X(modem|W(xmodem|Y(modem|B(atch Ymodem|K(ermit|Z(modem|?");
     REPEAT
           IF NOT GetString(c,30) THEN
               RETURN -1;
             ELSIF c<>"" THEN
               x:=Pos(ToUpper(c),"AXYBWKZ");
             ELSIF CarrierLost() THEN
               RETURN -1;
           END;
     UNTIL ((x=0) AND (AsciiOK)) OR ((x>=1) AND (x<=6));
     RETURN x;
END;

(*................................................*)

PROC SayProtocol(prot:Number; AddDelay:Flag);
BEGIN
     CASE prot OF
          0:SendString("ASCII");
       |  1:SendString("Xmodem");
       |  2:SendString("Ymodem");
       |  3:SendString("Ymodem Batch");
       |  4:SendString("WXmodem");
       |  5:SendString("Kermit");
       |  6:SendString("Zmodem");
     END;
     SendString(" protocol.|");
     IF AddDelay THEN Delay(5) END;
END;

(*................................................*)

PROC SayResult();
BEGIN
     SendString("|File Transfer ");
     IF FileOK THEN
         SendString("Complete.|")
       ELSE
         SendString("Failed.|")
     END;
END;

(*................................................*)

FUNC TransferFile(down:Flag; protocol:Number; FileSpec:String):Flag;
BEGIN
     IF down THEN
         RETURN Download(protocol,FileSpec,ResumeTransfer);
       ELSE
         RETURN Upload(Protocol,FileSpec);
     END;
END;

(*................................................*)

PROC GetFileFromUser();

VAR x:Number;
    Filename:String;

BEGIN
     x := GetFTMethod(FALSE);
     IF x<0 THEN RETURN END;
     IF (x=XMODEM) OR (x=WXMODEM) OR (x=YMODEM) THEN
         IF NOT GetFilename(Filename,FALSE) THEN RETURN END;
     END;
     SendString("|Ready to receive file using ");
     SayProtocol(x,FALSE);
     FileOK := TransferFile(TRUE,x,Filename);
     SayResult();
END;

(*................................................*)

PROC SendFileToUser();

VAR x:Number;
    f:File;
    blocks,bytes:String[10];
    Filename:String;

BEGIN
     x := GetFTMethod(TRUE);
     IF x<0 THEN RETURN END;
     IF NOT GetFilename(Filename,TRUE) THEN RETURN END;
     FOpen(f,Filename);
     FileSize(f,bytes,blocks);
     FClose(f);
     SendString("|File: "+Filename+"|  "+bytes+" bytes, ("+blocks+" Xmodem blocks).|");
     SendString("About to send file using ");
     SayProtocol(x,TRUE);
     Filename := FQualify(Filename);
     FileOK := TransferFile(FALSE,x,Filename);
     SayResult();
END;

(*................................................*)

PROC GetMenu();

VAR c:String[2];
    x:Number;

BEGIN
     REPEAT
           IF CarrierLost() OR LeaveHostMode() THEN RETURN END;
     UNTIL GetString(c,5);
     CASE c OF

         "C":IF PrivUser THEN
                 ChangeDirectory();
             END;
       | "S":IF PrivUser THEN
                 HostShell();
             END;
       | "F":DirectoryListing();
       | "U":GetFileFromUser();
       | "D":SendFileToUser();
       | "G":SendString("||Goodbye from Odyssey Host.|Please hang up now!!|");
             Delay(1);
             HangUp();
      ELSE
        IF c<>"" THEN SendString("|Error.|") END;
     END;
END;

(*................................................*)

PROC DisplayMenu();
BEGIN
     CurrDir := CurrentDir();
     REPEAT
           IF CarrierLost() OR LeaveHostMode() THEN RETURN END;
           IF PrivUser THEN
               SendString("|Directory=> "+CurrDir+"|C(hange dir, S(hell, ");
             ELSE
               SendString('|')
           END;
           SendString("F(iles, U(pload, D(ownload, G(oodbye|? ");
           GetMenu();
     UNTIL FALSE;
END;

(*.........................................*)

PROC HostSession();

VAR done,Ok:Flag;

BEGIN
     (* We get here when a carrier is detected *)
     SetHelp("");
     SetHelp(" Odyssey Host Mode:  { Call in Progress } ");
     IF NOT AlreadyConnected THEN
         Delay(1);
         SendString("||ODYSSEY "+OdyVersion()+" HOST MODE||");
         SendString(Welcome);
         Ok := GetPassword();
       ELSE
         Ok := TRUE;
     END;

     IF Ok THEN
         done := FALSE;
         REPEAT
               IF CarrierLost() OR LeaveHostMode() THEN
                   done:=TRUE
                 ELSE
                   DisplayMenu();
               END;
         UNTIL done;
     END;
     SetHelp("");
END;

(*.........................................*)

PROC EnterHostMode();
  VAR CallResult,cTimeout:Number;
BEGIN
     Delay(1); (* wait for any characters to clear *)
     REPEAT
         SetHelp(" Odyssey Host Mode:  { Waiting for Call }     Press Esc to leave host mode.");
         CallResult := WaitForCall();
         IF CallResult=1 THEN (* escape hit *)
             GotLeaveCmd := TRUE;
             RETURN;
           ELSIF CallResult=0 THEN
             cTimeout := 10;
             WHILE (cTimeout>0) AND (NOT OnLine()) DO
                 Delay(1);
                 DEC(cTimeout);
             END;
             IF OnLine() THEN
                 LostCarrier := FALSE;
                 Carrier := TRUE;
                 HostSession();
                 Carrier := FALSE;
                 Delay(1);
                 PortInit(DefaultBaudRate,8,None,1);
                 AutoAnswer(TRUE);
                 ChDir(HostDir);
             END;
           ELSE
             RETURN;
         END;
     UNTIL FALSE;
END;

(*.........................................*)

PROC InitHost();
BEGIN
     Emulate("TTY");
     DefaultBaudRate := DTESpeed();
     AlreadyConnected := OnLine();
     GotLeaveCmd := FALSE;
     CRoutTranslation(CRLF);
     OrigDir := CurrentDir();
     GetHostInfo(NormPass,PrivPass,Welcome,HostDir,MNPwanted);
     IF HostDir="" THEN HostDir:=OrigDir END;
     SetZmodem(FALSE,TRUE,FALSE); (* disable Zmodem auto-receive *)
     SetASCII(0,0,FALSE);
     IF NOT OnLine() THEN AutoAnswer(TRUE) END;
     ChDir(HostDir);
END;

(*.........................................*)

PROC ShutDown();
BEGIN
     ChDir(OrigDir);
     IF NOT OnLine() THEN AutoAnswer(FALSE) END;
     SetHelp("");
     RestoreDefaults();
END;

(*.........................................*)

BEGIN
     ClrScr();
     Carrier := OnLine();
     Priority(TRUE);
     CanEscape(FALSE);
     InitHost();
     EnterHostMode();
     ShutDown();
END;